準備

以下の通りにパッケージとデータセットを用意する。 すべてのコードは、githubに公開されています。

# load library ------------------------------------------------------------

pacman::p_load("tidyverse", "janitor", "stringr", "lubridate", "patchwork", "modelr")


# import dataset --------------------------------------------------------

path_to_github <- "https://raw.githubusercontent.com/Ricky-s-a/business_analysis/main/data/ST2187_coursework_dataset_2022_23.csv"
df_raw <- read_csv(path_to_github)

データセットの基本情報

このデータセットは、row: x columns:となっている。

# inspect the dataset -----------------------------------------------------

glimpse(df_raw)
## Rows: 51,290
## Columns: 24
## $ `Row ID`         <dbl> 32298, 26341, 25330, 13524, 47221, 22732, 30570, 3119…
## $ `Order ID`       <chr> "CA-2012-124891", "IN-2013-77878", "IN-2013-71249", "…
## $ `Order Date`     <chr> "8/1/2019", "2/6/2020", "10/17/2020", "1/29/2020", "1…
## $ `Ship Date`      <chr> "8/1/2019", "2/8/2020", "10/18/2020", "1/31/2020", "1…
## $ `Ship Mode`      <chr> "Same Day", "Second Class", "First Class", "First Cla…
## $ `Customer ID`    <chr> "RH-19495", "JR-16210", "CR-12730", "KM-16375", "RH-9…
## $ `Customer Name`  <chr> "Rick Hansen", "Justin Ritter", "Craig Reiter", "Kath…
## $ Segment          <chr> "Consumer", "Corporate", "Consumer", "Home Office", "…
## $ City             <chr> "New York City", "Wollongong", "Brisbane", "Berlin", …
## $ State            <chr> "New York", "New South Wales", "Queensland", "Berlin"…
## $ Country          <chr> "United States", "Australia", "Australia", "Germany",…
## $ `Postal Code`    <dbl> 10024, NA, NA, NA, NA, NA, NA, NA, 95823, 28027, 2230…
## $ Market           <chr> "US", "APAC", "APAC", "EU", "Africa", "APAC", "APAC",…
## $ Region           <chr> "East", "Oceania", "Oceania", "Central", "Africa", "O…
## $ `Product ID`     <chr> "TEC-AC-10003033", "FUR-CH-10003950", "TEC-PH-1000466…
## $ Category         <chr> "Technology", "Furniture", "Technology", "Technology"…
## $ `Sub-Category`   <chr> "Accessories", "Chairs", "Phones", "Phones", "Copiers…
## $ `Product Name`   <chr> "Plantronics CS510 - Over-the-Head monaural Wireless …
## $ Sales            <dbl> 2309.650, 3709.395, 5175.171, 2892.510, 2832.960, 286…
## $ Quantity         <dbl> 7, 9, 9, 5, 8, 5, 4, 6, 5, 13, 5, 5, 4, 7, 12, 4, 9, …
## $ Discount         <dbl> 0.0, 0.1, 0.1, 0.1, 0.0, 0.1, 0.0, 0.0, 0.2, 0.4, 0.0…
## $ Profit           <dbl> 762.1845, -288.7650, 919.9710, -96.5400, 311.5200, 76…
## $ `Shipping Cost`  <dbl> 933.57, 923.63, 915.49, 910.16, 903.04, 897.35, 894.7…
## $ `Order Priority` <chr> "Critical", "Critical", "Medium", "Medium", "Critical…

データクレンジング

  • コラムの名前を小文字にする
  • いくつかの変数の作成(order_date, ship_date, order_year, order_month, ship_year, gap_date, profit_ratio)
# tidy dataset ------------------------------------------------------------

df_tidy <- df_raw %>% 
  clean_names()

# tidy
df <- df_tidy %>% 
  mutate(
    order_date = as.Date(order_date, format = "%m/%d/%Y"),
    ship_date = as.Date(ship_date, format = "%m/%d/%Y"),
    order_year = year(order_date), 
    order_month = month(order_date),
    ship_year = year(ship_date),
    ship_month = month(ship_date),
    split_tf = round(runif(nrow(df_tidy), min = 1, max = 5)),
    gap_date = as.numeric(difftime(ship_date, order_date, units = "days")),
    profit_ratio = profit/sales
  ) %>% 
  arrange(desc(order_date)) 

# show 
glimpse(df)
## Rows: 51,290
## Columns: 31
## $ row_id         <dbl> 1783, 26535, 44025, 26333, 12929, 26335, 15693, 1787, 1…
## $ order_id       <chr> "MX-2014-116267", "IN-2014-43550", "RS-2014-1460", "IN-…
## $ order_date     <date> 2021-12-31, 2021-12-31, 2021-12-31, 2021-12-31, 2021-1…
## $ ship_date      <date> 2022-01-03, 2022-01-01, 2022-01-02, 2022-01-03, 2022-0…
## $ ship_mode      <chr> "Second Class", "First Class", "Second Class", "First C…
## $ customer_id    <chr> "EB-13975", "ML-17395", "PB-9105", "JD-16150", "JG-1580…
## $ customer_name  <chr> "Erica Bern", "Marina Lichtenstein", "Peter Bühler", "J…
## $ segment        <chr> "Corporate", "Corporate", "Consumer", "Corporate", "Cor…
## $ city           <chr> "São Paulo", "Jakarta", "Ufa", "Bangkok", "Maidenhead",…
## $ state          <chr> "São Paulo", "Jakarta", "Bashkortostan", "Bangkok", "En…
## $ country        <chr> "Brazil", "Indonesia", "Russia", "Thailand", "United Ki…
## $ postal_code    <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 10009, …
## $ market         <chr> "LATAM", "APAC", "EMEA", "APAC", "EU", "APAC", "EU", "L…
## $ region         <chr> "South", "Southeast Asia", "EMEA", "Southeast Asia", "N…
## $ product_id     <chr> "TEC-CO-10000137", "FUR-BO-10004679", "TEC-HEW-10004652…
## $ category       <chr> "Technology", "Furniture", "Technology", "Furniture", "…
## $ sub_category   <chr> "Copiers", "Bookcases", "Copiers", "Tables", "Phones", …
## $ product_name   <chr> "Canon Wireless Fax, Color", "Safco Library with Doors,…
## $ sales          <dbl> 1264.4660, 1091.2806, 865.6200, 1048.7313, 867.3000, 29…
## $ quantity       <dbl> 5, 3, 6, 9, 5, 3, 3, 3, 2, 9, 4, 4, 4, 5, 2, 3, 3, 4, 2…
## $ discount       <dbl> 0.002, 0.070, 0.000, 0.570, 0.000, 0.270, 0.100, 0.000,…
## $ profit         <dbl> 301.4660, 46.9206, 51.8400, -1195.2387, 251.4000, 68.11…
## $ shipping_cost  <dbl> 253.25, 243.11, 138.18, 86.86, 53.16, 52.11, 51.79, 51.…
## $ order_priority <chr> "High", "High", "High", "High", "Medium", "High", "Medi…
## $ order_year     <dbl> 2021, 2021, 2021, 2021, 2021, 2021, 2021, 2021, 2021, 2…
## $ order_month    <dbl> 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,…
## $ ship_year      <dbl> 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2022, 2…
## $ ship_month     <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 12, 1, 1, 1, 12, 1, 1, 1,…
## $ split_tf       <dbl> 5, 3, 3, 3, 3, 3, 2, 3, 3, 4, 5, 3, 2, 3, 3, 3, 3, 5, 2…
## $ gap_date       <dbl> 3, 1, 2, 3, 5, 3, 2, 3, 4, 5, 0, 4, 4, 1, 0, 4, 5, 5, 5…
## $ profit_ratio   <dbl> 0.23841369, 0.04299591, 0.05988771, -1.13969965, 0.2898…

探索的データ分析

数値データの基本統計量

gap_date()(ship_date - order_date)で計算されている。 注目したいのは、salesの分布が非常に広いことである。上は、2.263848^{4}, 下は、0.444となっていることから、高額な買い物をする顧客と少額決済をする顧客がいることがわかる。

\[ profit = sales - cost \\ quantity \times price - cost) \]

であるため、分析の方向としては、どうしたらprofitを改善させることができるのかということを最終的な目標として設定したい。

discountに関しては内政変数であるため、その効果が実際にあったのかについての政策評価することもできるし、どうしたら利益率を改善できるのかについての政策提言もできるかもしれない。

# summary of numeric data
df %>% 
    select(where(is.numeric)) %>% 
    select(!ends_with(c("year", "month", "id", "tf", "code"))) %>% 
  summary()
##      sales              quantity         discount          profit        
##  Min.   :    0.444   Min.   : 1.000   Min.   :0.0000   Min.   :-6599.98  
##  1st Qu.:   30.759   1st Qu.: 2.000   1st Qu.:0.0000   1st Qu.:    0.00  
##  Median :   85.053   Median : 3.000   Median :0.0000   Median :    9.24  
##  Mean   :  246.491   Mean   : 3.477   Mean   :0.1429   Mean   :   28.61  
##  3rd Qu.:  251.053   3rd Qu.: 5.000   3rd Qu.:0.2000   3rd Qu.:   36.81  
##  Max.   :22638.480   Max.   :14.000   Max.   :0.8500   Max.   : 8399.98  
##  shipping_cost       gap_date      profit_ratio     
##  Min.   :  0.00   Min.   :0.000   Min.   :-4.73354  
##  1st Qu.:  2.61   1st Qu.:3.000   1st Qu.: 0.00000  
##  Median :  7.79   Median :4.000   Median : 0.16918  
##  Mean   : 26.38   Mean   :3.969   Mean   : 0.04743  
##  3rd Qu.: 24.45   3rd Qu.:5.000   3rd Qu.: 0.33314  
##  Max.   :933.57   Max.   :7.000   Max.   : 0.50000

数値データのそれぞれのヒストグラム

done!

# numeric variables
num_vars <- 
  df %>% 
  select(where(is.numeric)) %>% 
  select(!ends_with(c("year", "month", "id", "tf", "code"))) %>%
  colnames()

# define the function

# each 
results <- lapply(num_vars,
       FUN = function(n) {
         # print(
          ggplot(df, aes_string(n)) +
          geom_histogram()
         # )
       }
)

# name the list 
results <- `names<-`(results, num_vars)

# show 
results
## $sales

## 
## $quantity

## 
## $discount

## 
## $profit

## 
## $shipping_cost

## 
## $gap_date

## 
## $profit_ratio

discountについて

数値データの中で唯一のコントロールできる変数だから、深ぼっていきたい。

discout histgram

全体の65%ぐらいが、20%未満の割引なんだな。 割引しすぎてるってのが、問題なのかも。

df$discount %>% hist()

discount v.s. profit ratio

discout しすぎてネガティブになっているのは、渋くない? 特に割引率が高すぎるものは、profitがネガティブになっているものもある。 そういうものって何なんだろう?どのような財? 割引しないときは、どれくらいの利益率なのか?

df %>% 
  ggplot(aes(discount, profit_ratio)) + 
  geom_ref_line(h = 0) +
  geom_jitter() +
  geom_smooth(method = "lm") 

日付データのレンジ

データのレンジは、2018年1月1日から2021年12月31日まで。

# date range
df %>% 
  select(ends_with("date")) %>% 
  select(!gap_date) %>% 
  lapply(range)
## $order_date
## [1] "2018-01-01" "2021-12-31"
## 
## $ship_date
## [1] "2018-01-03" "2022-01-07"

カテゴリカルデータの数

オーダー数とorder_idとの関係とは?これがはっきりしない。

総データのエントリー数が、row:51290なのに対して、customer_idは、1500程度しかない。 もしかしたら、繰り返し買っている顧客(お得意様)とそうでない新規顧客が存在するのではないか。 それぞれに対して別々のアプローチをとることで、利益率を改善させることができるかもしれない。

世界中の国々ついて述べるのは労力をともなうため、上位5か国とか、マーケットごとでまとめたほうがいいかもしれない。productについても同じことが言えそう。

order_priorityは、実際に利益率改善に役に立っているのか。どかも分析もできそう。

# check the number of unique categorical variables
df_tidy %>% 
  select(where(is.character)) %>% 
  lapply(unique) %>%
  lapply(length)
## $order_id
## [1] 25035
## 
## $order_date
## [1] 1430
## 
## $ship_date
## [1] 1464
## 
## $ship_mode
## [1] 4
## 
## $customer_id
## [1] 1590
## 
## $customer_name
## [1] 795
## 
## $segment
## [1] 3
## 
## $city
## [1] 3636
## 
## $state
## [1] 1094
## 
## $country
## [1] 147
## 
## $market
## [1] 7
## 
## $region
## [1] 13
## 
## $product_id
## [1] 10292
## 
## $category
## [1] 3
## 
## $sub_category
## [1] 17
## 
## $product_name
## [1] 3788
## 
## $order_priority
## [1] 4

気になる変数とその関係

気になる変数を深堀していく。

月々のオーダーの数と出荷数

毎年11月、12月にかけてオーダー数が増えている。(?) シーズンによって商品のオーダー数が増えているかの確かめをしたほうがいいかも。 これ、オーダー数だけじゃなくて、profit, quantity, salesに対してもやったほうがいいな。

g1 <- 
  df %>%
  mutate(colour = if_else(order_month %in% c(11, 12), "red", "blue")) %>% 
  group_by(order_year, order_month) %>% 
  ggplot() + 
  aes(order_date, fill = colour) +
  geom_bar()

g1

2018年の例

ざっと見た感じ、11月、12月に注文数が多くなっているのがわかる。

df %>% 
  group_by(order_year, order_date) %>% 
  summarise(total = n()) %>% filter(order_year == 2018, total > 50) 
## # A tibble: 31 × 3
## # Groups:   order_year [1]
##    order_year order_date total
##         <dbl> <date>     <int>
##  1       2018 2018-03-01    53
##  2       2018 2018-06-07    60
##  3       2018 2018-06-22    55
##  4       2018 2018-08-25    53
##  5       2018 2018-09-02    60
##  6       2018 2018-09-08    76
##  7       2018 2018-09-14    63
##  8       2018 2018-09-23    54
##  9       2018 2018-09-26    56
## 10       2018 2018-09-27    57
## # … with 21 more rows

オーダーを受けてから出荷するまでの日付に国ごとのばらつきはあるのか?

ない!

# there must be some variations in the gap between the order date and the ship date.
# Q. how is the gap between the order date and the ship date?
df %>% 
  ggplot(aes(gap_date, region)) +
  geom_boxplot()

出荷費用に関しては、どのような国ごとのばらつきはあるのか?

# there must be some variations in the shipping cost across countries.
# Q. how much is that? 
g_corporate <- df %>% 
  filter(segment == "Corporate") %>% 
  ggplot(aes(shipping_cost, market)) +
  geom_boxplot() +
  labs(title = "Corporate")

g_consumer <- df %>% 
  filter(segment == "Consumer") %>% 
  ggplot(aes(shipping_cost, market)) +
  geom_boxplot() + 
  labs(title = "Consumer")

g_home_office <- df %>% 
  filter(segment == "Home Office") %>% 
  ggplot(aes(shipping_cost, market)) +
  geom_boxplot() +
  labs(title = "Home Office")

g_corporate / g_consumer / g_home_office

年毎の利益と地域

# basic info --------------------------------------------------------------

# the ration of regions in profit on the annual basis
df %>% 
  group_by(order_year, order_month, region) %>%
  summarise(sum_profit = sum(profit)) %>% 
  ggplot(aes(order_year, sum_profit, fill = region)) + 
  geom_col()

年ごとの利益 (要検討)

# total profit by year
profit_by_year <- 
  df %>% group_by(order_year) %>% 
  summarise(annual_profit = sum(profit))

# profit ratio by year
df %>% 
  group_by(order_year, order_month, market) %>%
  summarise(sum_profit = sum(profit)) %>% 
  mutate(profit_ratio_by_year = sum_profit/filter(profit_by_year, order_year == order_year)[[2]]) %>% 
  arrange(order_year, desc(sum_profit)) 
## # A tibble: 335 × 5
## # Groups:   order_year, order_month [48]
##    order_year order_month market sum_profit profit_ratio_by_year
##         <dbl>       <dbl> <chr>       <dbl>                <dbl>
##  1       2018           9 EU         13805.               0.0555
##  2       2018          12 APAC       13516.               0.0442
##  3       2018          10 APAC       13496.               0.0441
##  4       2018          12 EU         11540.               0.0464
##  5       2018          11 US          9292.               0.0228
##  6       2018           6 APAC        9216.               0.0301
##  7       2018          12 US          8984.               0.0220
##  8       2018          11 APAC        8951.               0.0293
##  9       2018           9 US          8328.               0.0204
## 10       2018           6 EU          7799.               0.0313
## # … with 325 more rows

どのマーケットが一番儲かっているのか?

Especially the markets in APAc and EU are expanding.

# Q. the most profitable market, product, category, sub_category, 
df %>% 
  group_by(order_year, market) %>% 
  summarise(profit = sum(profit)) %>% 
  arrange(order_year,desc(profit)) %>% 
  top_n(5, profit)
## # A tibble: 20 × 3
## # Groups:   order_year [4]
##    order_year market  profit
##         <dbl> <chr>    <dbl>
##  1       2018 APAC    83032.
##  2       2018 EU      61626.
##  3       2018 US      49544.
##  4       2018 LATAM   36708.
##  5       2018 Africa  10944.
##  6       2019 APAC    89321.
##  7       2019 EU      83775.
##  8       2019 US      61180.
##  9       2019 LATAM   49524.
## 10       2019 Africa  11909.
## 11       2020 APAC   123193.
## 12       2020 EU      98484.
## 13       2020 US      82165.
## 14       2020 LATAM   62077.
## 15       2020 Africa  26687.
## 16       2021 APAC   140454.
## 17       2021 EU     128944.
## 18       2021 US      93508.
## 19       2021 LATAM   73335.
## 20       2021 Africa  39331.

どの国が特に利益を上げているのか?

The presence of China and India is growing.

# Q. which country?
df %>% 
  filter(market %in% c("APAC", "EU")) %>% 
  group_by(order_year, country) %>% 
  summarise(market_profit = sum(profit)) %>% 
  arrange(order_year, desc(market_profit)) %>% 
  top_n(3, market_profit)
## # A tibble: 12 × 3
## # Groups:   order_year [4]
##    order_year country        market_profit
##         <dbl> <chr>                  <dbl>
##  1       2018 China                 33181.
##  2       2018 United Kingdom        20080.
##  3       2018 India                 19929.
##  4       2019 United Kingdom        27366.
##  5       2019 India                 27329.
##  6       2019 China                 26234.
##  7       2020 China                 44474.
##  8       2020 India                 33007.
##  9       2020 France                32316.
## 10       2021 India                 48808.
## 11       2021 China                 46794.
## 12       2021 United Kingdom        36756.

インドと中国では特にどのsubcategoryが売れているのか?

technology, furniture, office suplliesで変らない。

# which category is sold in those region? 
df %>% 
  filter(country %in% c("India", "China")) %>% 
  group_by(order_year, sub_category) %>% 
  summarise(profit_by_subcategory = sum(profit)) %>% 
  arrange(order_year, desc(profit_by_subcategory)) %>% 
  top_n(10, desc(profit_by_subcategory)) 
## # A tibble: 40 × 3
## # Groups:   order_year [4]
##    order_year sub_category profit_by_subcategory
##         <dbl> <chr>                        <dbl>
##  1       2018 Machines                     2599.
##  2       2018 Furnishings                  2008.
##  3       2018 Envelopes                    1187.
##  4       2018 Supplies                     1073.
##  5       2018 Binders                      1022.
##  6       2018 Art                           819.
##  7       2018 Paper                         763.
##  8       2018 Fasteners                     478.
##  9       2018 Labels                        224.
## 10       2018 Tables                      -1465.
## # … with 30 more rows

大手取引先はいるのか?

いるが、それぞれがバラバラ。もっとフォローアップを増やし、one-timeではなく、継続的な大手取引先を作るべき。

df %>% 
  group_by(order_year, customer_id) %>% 
  summarise(profit_by_customer = sum(profit)) %>% 
  arrange(order_year, desc(profit_by_customer)) %>% 
  top_n(10, profit_by_customer) 
## # A tibble: 40 × 3
## # Groups:   order_year [4]
##    order_year customer_id profit_by_customer
##         <dbl> <chr>                    <dbl>
##  1       2018 SC-20095                 5716.
##  2       2018 CA-11965                 3121.
##  3       2018 NM-18445                 2950.
##  4       2018 GT-14710                 2909.
##  5       2018 ON-18715                 2689.
##  6       2018 ER-13855                 2618.
##  7       2018 TB-21400                 2549.
##  8       2018 KN-16390                 2453.
##  9       2018 HL-15040                 2405.
## 10       2018 RB-19330                 2238.
## # … with 30 more rows

大手取引先の属性情報は?

# top10 customers customer's id for every year.
major_customers <- 
  df %>% 
  group_by(order_year, customer_id) %>% 
  summarise(profit_by_customer = sum(profit)) %>% 
  arrange(order_year, desc(profit_by_customer)) %>% 
  top_n(10, profit_by_customer) %>%
  ungroup() %>%  
  select(customer_id) %>% 
  unlist() %>% 
  unname()


df %>% 
  filter(customer_id %in% major_customers) %>%
  group_by(order_year, customer_id, sub_category) %>% 
  summarise(profit_by_subcategory = sum(profit)) %>% 
  arrange(order_year, desc(profit_by_subcategory)) %>% 
  top_n(1, profit_by_subcategory)
## # A tibble: 152 × 4
## # Groups:   order_year, customer_id [152]
##    order_year customer_id sub_category profit_by_subcategory
##         <dbl> <chr>       <chr>                        <dbl>
##  1       2018 SC-20095    Binders                      5480.
##  2       2018 CA-11965    Phones                       2939.
##  3       2018 ER-13855    Appliances                   2476.
##  4       2018 TB-21400    Machines                     2240.
##  5       2018 ON-18715    Chairs                       2125.
##  6       2018 NM-18445    Machines                     1996.
##  7       2018 HL-15040    Phones                       1930.
##  8       2018 DR-12940    Appliances                   1644.
##  9       2018 KN-16390    Tables                       1528.
## 10       2018 GT-14710    Chairs                       1474.
## # … with 142 more rows

5ページの構成

page2: What is the most profitable/less profitable product subcategory?

table

table <- 
  df %>% 
  group_by(order_year, sub_category) %>% 
  summarise(profit_ratio_year = sum(profit)/sum(sales)) %>% 
  arrange(order_year, desc(profit_ratio_year)) 

# show the table
DT::datatable(table, 
              rownames = FALSE, 
              extensions = 'Buttons',
              options = list(autoWidth = TRUE,
                             pageLength = 5,
                             dom = 'Bfrtip',
                             buttons = list("csv"),
                             scrollX = TRUE,
                             scrollCollapse = TRUE),
              class = 'cell-border stripe'
  )

graph

テーブルがありえんくらい利益率低いな。 これ売らないほうがいいんじゃない?

# graph 
g_pg1_3 <- 
  table %>% 
  ggplot(aes(factor(order_year), profit_ratio_year, colour = sub_category, group = sub_category)) +
  geom_point() +
  geom_line()

plotly::ggplotly(g_pg1_3)

もしもテーブルを売らなかったら?

page3: Is the discout effective?

page4: country/region/market

page5:

最後に、、、

興味のある方は以下のQRコードを参照して、サイトにアクセスしてみてください。

qrcode::qr_code("https://htmlpreview.github.io/?https://raw.githubusercontent.com/Ricky-s-a/business_analysis/main/report/prep_for_coursework_2022_23.html") %>% plot()